home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
PROGS
/
TMAP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-03
|
13KB
|
476 lines
Program TMAP;
{ to read Turbo MAP files and produce meaningful output }
uses DOS, PbMISC, PbDATA, PbOBJS, PbOUT0, PbPARMS;
var TMAP_Data : byte; { TMAP marker }
type symbolstr = string[22];
var rptlvl : integer;
MapName : string[40];
CodeEndAddress : longint;
DataStartAddress : longint;
SortSymbolsFlag : boolean;
SortMsg : string[40];
DataSegIndex : integer;
PrevSegname : symbolstr;
var ExcludeSymbolsFlag : boolean;
{ Segment map stuff }
type SegMapType = record
itemname : symbolstr;
baseaddr : longint;
endaddr : longint;
len : longint;
typ : string[6];
end;
const SegMax = 50;
var SegMap : array[1..SegMax] of SegMapType;
SegCnt : integer;
{ Publics map stuff }
type PubMapType = record
itemname : symbolstr;
baseaddr : longint;
len : longint;
dataseg : integer;
end;
const PubMax = 500;
var PubMap : array[1..PubMax] of PubMapType;
Pubcnt : integer;
var TMAP_DataEnd : byte; { TMAP marker }
{*PAGE SegMap*}
{ ------------- SegMap - Segment Information of the Map file ----------- }
Procedure InitSegMap;
begin
fillchar(SegMap,sizeof(SegMap),0);
SegCnt := 0;
end;
function FmtSegItem(Seg : SegMapType ) : string;
var s : string;
s1,s2,s3 : symbolstr;
begin
s := '';
s := s + leftstr(Seg.itemname,20) +
leftstr(Seg.typ,6);
str(Seg.baseaddr,s1); s := s + ' b:' + leftstr(s1,7);
str(Seg.endaddr,s2); s := s + ' e:' + leftstr(s2,7);
str(Seg.len,s3); s := s + ' l:' + leftstr(s3,7);
FmtSegItem := s;
end;
Procedure DecodeSegLine(s : string);
var Seg : SegMapType;
var s1 : symbolstr;
begin
fillchar(Seg,sizeof(Seg),0);
Seg.baseaddr := HexToLongint(copy(s,2,5));
Seg.endaddr := HexToLongint(copy(s,9,5));
Seg.len := HexToLongint(copy(s,16,5));
Seg.itemname := copy(s,23,19);
Seg.typ := copy(s,42,6) + ' ';
if SegCnt < SegMax then
begin
inc(SegCnt);
SegMap[SegCnt] := Seg;
end;
if leftstr(Seg.typ,4) = 'DATA' then DataStartAddress := Seg.baseaddr;
if leftstr(Seg.typ,4) = 'CODE' then
if Seg.endaddr > CodeEndAddress then CodeEndAddress := Seg.endaddr;
end;
Procedure SortSegMap;
var i,j : integer;
Seg : SegMapType;
begin
for i := 1 to SegCnt-1 do
begin
for j := i+1 to SegCnt do
begin
if SegMap[i].len < SegMap[j].len then
begin
Seg := SegMap[i];
SegMap[i] := SegMap[j];
SegMap[j] := Seg;
end;
end;
end;
end;
Procedure ListSegMap(progname : string; lvl : integer);
var i : integer;
lcode,ldata,lheap,lstack : longint;
begin
if lvl >= 0 then
begin
lcode := 0; ldata := 0; lheap := 0; lstack := 0;
for i := 1 to SegCnt do
begin
if SegMap[i].typ = 'CODE ' then lcode := lcode + SegMap[i].len
else if SegMap[i].typ = 'DATA ' then ldata := ldata + SegMap[i].len
else if SegMap[i].typ = 'STACK ' then lstack:= lstack+ SegMap[i].len
else if SegMap[i].typ = 'HEAP ' then lheap := lheap + SegMap[i].len
else begin end;
end;
OUT(leftstr(progname,20)+
' EXE:'+FmtKstr(SizeOfFile(progname,'exe'))+
' Code:'+FmtKstr(lcode)+
' Data:'+FmtKstr(ldata)+
' Stack:'+FmtKstr(lstack)+
' Heap:'+FmtKstr(lheap));
end;
if lvl > 1 then
begin
if SortSymbolsFlag then SortSegMap;
OUT('Segment Map entries:'+integerstr(SegCnt-1,3)+
' '+sortmsg);
for i := 1 to SegCnt-1 do
begin
OUT(' - '+FmtSegItem(SegMap[i]));
end;
OUT('');
end;
end;
{*PAGE PubMap*}
{ ------------- PubMap - Public Symbols Information of the Map file ----------- }
Procedure InitPubMap;
begin
fillchar(PubMap,sizeof(PubMap),0);
Pubcnt := 0;
end;
Procedure DecodePubLine(s : string);
var Pub : PubMapType;
var s1 : symbolstr;
begin
if length(s) < 10 then exit;
fillchar(Pub,sizeof(Pub),0);
Pub.baseaddr := HexAddressToLongint(copy(s,2,9));
Pub.len := 0;
Pub.itemname := copy(s,18,20);
if Pubcnt < PubMax then
begin
inc(Pubcnt);
PubMap[Pubcnt] := Pub;
end;
end;
Function FindSegmentIndex(var Pub : PubMapType) : integer;
var s : string[40];
i,j : integer;
found : boolean;
begin
found := false;
i := 0;
j := 1;
while (i < SegCnt) and not found do
begin
inc(i);
if (Pub.baseaddr >= SegMap[i].baseaddr) and
(Pub.baseaddr <= SegMap[i].baseaddr + SegMap[i].len) then
begin
found := true;
j := i;
end;
end;
FindSegmentIndex := j;
end;
function PubItemSegmentName(var Pub : PubMapType) : string;
var s : string[40];
i : integer;
l : longint;
begin
s := '??';
i := FindSegmentIndex(Pub);
if i > 0 then
begin
s := SegMap[i].itemname;
if (Pub.baseaddr + Pub.len) > SegMap[i].endaddr then
begin
l := Pub.len;
Pub.len := SegMap[i].endaddr - Pub.baseaddr;
end;
end;
PubItemSegmentName := s;
end;
Procedure ProcessPubItem(var Pub : PubMapType);
var i,seglen,ndx : integer;
s,segname,suffix : string[40];
begin
s := Pub.itemname;
i := pos('_',s);
if i > 1 then
begin
suffix := s;
delete(suffix,1,i-1);
segname := leftstr(s,i-1);
ndx := 0;
for i := 1 to SegCnt do
begin
seglen := length(segname);
if segname = leftstr(SegMap[i].itemname,seglen) then ndx := i;
end;
Pub.dataseg := DataSegIndex;
if suffix = '_DATA' then
begin
if ndx > 0 then DataSegIndex := ndx;
Pub.dataseg := DataSegIndex;
end
else if suffix = '_ENDDATA' then DataSegIndex := 0
else if suffix = '_PRIVATEDATA' then DataSegIndex := 0;
end
else Pub.dataseg := DataSegIndex;
end;
Procedure ComputePLengths;
var i,j : integer;
Pub : PubMapType;
begin
if Pubcnt < 2 then exit;
for i := 1 to Pubcnt-1 do
begin
if (PubMap[i+1].baseaddr = DataStartAddress) then
begin
PubMap[i].len := CodeEndAddress - PubMap[i].baseaddr;
end
else PubMap[i].len := PubMap[i+1].baseaddr - PubMap[i].baseaddr;
ProcessPubItem(PubMap[i]);
end;
end;
Procedure SortPubMap;
var i,j,x : integer;
s : symbolstr;
Pub : PubMapType;
begin
x := 0;
for i := 1 to Pubcnt-1 do
if (PubMap[i].baseaddr < DataStartAddress) then
begin
s := PubItemSegmentName(PubMap[i]); {does length adjustment}
x := i;
end;
for i := 1 to x-1 do
begin
for j := i+1 to x do
begin
if (PubMap[i].len < PubMap[j].len) then
begin
Pub := PubMap[i];
PubMap[i] := PubMap[j];
PubMap[j] := Pub;
end;
end;
end;
end;
function FmtPubItem(Pub : PubMapType ) : string;
var s : string;
s1,s2,s3 : symbolstr;
i : integer;
begin
s := ' ';
s := s + leftstr(Pub.itemname,20);
if Pub.baseaddr < DataStartAddress then
begin
s := s + ' CODE (' + leftstr(PubItemSegmentName(Pub),20)+ ') ';
end
else begin
s := s + ' DATA (';
s1 := '';
i := Pub.dataseg;
if i > 0 then
begin
s1 := leftstr(SegMap[i].itemname,20);
if s1 <> prevsegname then OUT(' ');
s := s + s1 + ') ';
end
else s := s + ' ) ';
prevsegname := s1;
end;
str(Pub.baseaddr,s1); s := s + ' b:' + leftstr(s1,7);
str(Pub.len,s3); s := s + ' l:' + leftstr(s3,7);
FmtPubItem := s;
end;
Procedure ListPubMap(progname : string; lvl : integer);
var i : integer;
excludebytes : longint;
excludecount : integer;
KeepSymbol : boolean;
begin
if lvl > 2 then
begin
ComputePLengths;
if SortSymbolsFlag then SortPubMap;
OUT('Publics Map entries:'+integerstr(PubCnt,3)+
' '+sortmsg);
excludebytes := 0;
excludecount := 0;
for i := 1 to Pubcnt do
begin
KeepSymbol := (not CheckOK('#'+PubMap[i].itemname))
or (not ExcludeSymbolsFlag );
if KeepSymbol then
OUT(FmtPubItem(PubMap[i]))
else begin
excludebytes := excludebytes + PubMap[i].len;
inc(excludecount);
end;
end;
OUT('');
end;
if (excludecount > 0) and (rptlvl > 2) then
begin
OUT('');
OUT('There were '+integerstr(excludecount,4)+
' Excluded symbols, totaling '+
integerstr(excludebytes,5)+' bytes.');
OUT('');
end;
end;
{*PAGE TMAP Main code*}
Procedure ProcessMapFile(progname: string; lvl : integer);
var s : string;
done : boolean;
tx : TFILE_object;
begin
InitSegMap;
InitPubMap;
done := false;
tx.init(progname,false);
while tx.fetchnext(s) and (not done) do
begin
if (s[7] = 'H') and (s[8] = ' ') then DecodeSegLine(s)
else if (s[6] = ':') then DecodePubLine(s)
else begin { writeln('?',s) } end;
end;
if SegCnt > 0 then ListSegMap(progname,lvl)
else OUT('SegMap array is empty.');
if Pubcnt > 0 then ListPubMap(progname,lvl)
else OUT('PubMap array is empty.');
tx.done;
end;
Procedure ProcessMapFiles(fn : string; lvl : integer);
var SR :searchrec;
i : integer;
done : boolean;
fname, dirstr : string[40];
begin
fname := fn;
i := pos('.',fname);
if i = 0 then fname := fname + '.map';
i := Pos('*',fname);
if i = 0 then
begin
Getdir(0,dirstr);
i := pos('\',fname);
if i = 0 then fname := dirstr + '\' + fname;
ProcessMapFile(fname,lvl);
end
else begin
dirstr := fname;
done := false;
i := length(fname);
while (i > 0) and not done do
begin
if dirstr[i] = '\' then done := true
else delete(dirstr,i,1);
dec(i);
end;
FindFirst(fname,anyfile,SR);
while dosError = 0 do
begin
ProcessMapFile(dirstr+SR.name,lvl);
FindNext(SR);
end;
end;
end;
Procedure Init;
begin
DataSegIndex := 0;
PrevSegname := '';
rptlvl := 0;
ExcludeSymbolsFlag := true;
SortSymbolsFlag := false;
DataStartAddress := 0;
CodeEndAddress := 0;
MapName := '*.map';
addparm(1,'EXCLUDE','YES');
addparm(1,'SORT','NO');
addparm(1,'LEVEL','0');
StandardOUTInit;
ExcludeSymbolsFlag := CheckOK('EXCLUDE');
SortSymbolsFlag := CheckOK('SORT');
rptlvl := GetParmNum('LEVEL');
if paramcount > 0 then
begin
MapName := paramstr(1);
if ScanParms('1') then rptlvl := 1;
if ScanParms('2') then rptlvl := 2;
if ScanParms('3') then rptlvl := 3;
if ScanParms('4') then rptlvl := 4;
end
else ShowdocFile;
if rptlvl > 2 then pOutFile := 'LPT1'; { assume output to printer }
if SortSymbolsFlag then SortMsg := 'Code entries sorted by size(bytes).'
else SortMsg := 'Code entries in address order.'
end;
begin { MAIN }
pProgID := 'TMAP 1.02';
Init;
ProcessMapFiles(MapName, rptlvl);
OUTDone;
end.